home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / perl5 / Config / General.pm
Encoding:
Perl POD Document  |  2010-04-09  |  71.6 KB  |  2,539 lines
  1. #
  2. # Config::General.pm - Generic Config Module
  3. #
  4. # Purpose: Provide a convenient way for loading
  5. #          config values from a given file and
  6. #          return it as hash structure
  7. #
  8. # Copyright (c) 2000-2010 Thomas Linden <tlinden |AT| cpan.org>.
  9. # All Rights Reserved. Std. disclaimer applies.
  10. # Artistic License, same as perl itself. Have fun.
  11. #
  12. # namespace
  13. package Config::General;
  14.  
  15. use strict;
  16. use warnings;
  17. use English '-no_match_vars';
  18.  
  19. use IO::File;
  20. use FileHandle;
  21. use File::Spec::Functions qw(splitpath file_name_is_absolute catfile catpath);
  22. use File::Glob qw/:glob/;
  23.  
  24.  
  25. # on debian with perl > 5.8.4 croak() doesn't work anymore without this.
  26. # There is some require statement which dies 'cause it can't find Carp::Heavy,
  27. # I really don't understand, what the hell they made, but the debian perl
  28. # installation is definetly bullshit, damn!
  29. use Carp::Heavy;
  30.  
  31.  
  32. use Carp;
  33. use Exporter;
  34.  
  35. $Config::General::VERSION = 2.48;
  36.  
  37. use vars  qw(@ISA @EXPORT_OK);
  38. use base qw(Exporter);
  39. @EXPORT_OK = qw(ParseConfig SaveConfig SaveConfigString);
  40.  
  41. sub new {
  42.   #
  43.   # create new Config::General object
  44.   #
  45.   my($this, @param ) = @_;
  46.   my $class = ref($this) || $this;
  47.  
  48.   # define default options
  49.   my $self = {
  50.           # sha256 of current date
  51.           # hopefully this lowers the probability that
  52.           # this matches any configuration key or value out there
  53.           # bugfix for rt.40925
  54.           EOFseparator          => 'ad7d7b87f5b81d2a0d5cb75294afeb91aa4801b1f8e8532dc1b633c0e1d47037',
  55.           SlashIsDirectory      => 0,
  56.           AllowMultiOptions     => 1,
  57.           MergeDuplicateOptions => 0,
  58.           MergeDuplicateBlocks  => 0,
  59.           LowerCaseNames        => 0,
  60.           ApacheCompatible      => 0,
  61.           UseApacheInclude      => 0,
  62.           IncludeRelative       => 0,
  63.           IncludeDirectories    => 0,
  64.           IncludeGlob           => 0,
  65.               IncludeAgain          => 0,
  66.           AutoLaunder           => 0,
  67.           AutoTrue              => 0,
  68.           AutoTrueFlags         => {
  69.                     true  => '^(on|yes|true|1)$',
  70.                     false => '^(off|no|false|0)$',
  71.                        },
  72.           DefaultConfig         => {},
  73.           String                => '',
  74.           level                 => 1,
  75.           InterPolateVars       => 0,
  76.           InterPolateEnv        => 0,
  77.           ExtendedAccess        => 0,
  78.           SplitPolicy           => 'guess', # also possible: whitespace, equalsign and custom
  79.           SplitDelimiter        => 0,       # must be set by the user if SplitPolicy is 'custom'
  80.           StoreDelimiter        => 0,       # will be set by me unless user uses 'custom' policy
  81.           CComments             => 1,       # by default turned on
  82.           BackslashEscape       => 0,       # deprecated
  83.           StrictObjects         => 1,       # be strict on non-existent keys in OOP mode
  84.           StrictVars            => 1,       # be strict on undefined variables in Interpolate mode
  85.           Tie                   => q(),      # could be set to a perl module for tie'ing new hashes
  86.           parsed                => 0,       # internal state stuff for variable interpolation
  87.           files                 => {},      # which files we have read, if any
  88.           UTF8                  => 0,
  89.           SaveSorted            => 0,
  90.               ForceArray            => 0        # force single value array if value enclosed in []
  91.          };
  92.  
  93.   # create the class instance
  94.   bless $self, $class;
  95.  
  96.   if ($#param >= 1) {
  97.     # use of the new hash interface!
  98.     $self->_prepare(@param);
  99.   }
  100.   elsif ($#param == 0) {
  101.     # use of the old style
  102.     $self->{ConfigFile} = $param[0];
  103.     if (ref($self->{ConfigFile}) eq 'HASH') {
  104.       $self->{ConfigHash} = delete $self->{ConfigFile};
  105.     }
  106.   }
  107.   else {
  108.     # this happens if $#param == -1,1 thus no param was given to new!
  109.     $self->{config} = $self->_hashref();
  110.     $self->{parsed} = 1;
  111.   }
  112.  
  113.   # find split policy to use for option/value separation
  114.   $self->_splitpolicy();
  115.  
  116.   # bless into variable interpolation module if neccessary
  117.   $self->_blessvars();
  118.  
  119.   # process as usual
  120.   if (!$self->{parsed}) {
  121.     $self->_process();
  122.   }
  123.  
  124.   if ($self->{InterPolateVars}) {
  125.     $self->{config} = $self->_clean_stack($self->{config});
  126.   }
  127.  
  128.   # bless into OOP namespace if required
  129.   $self->_blessoop();
  130.  
  131.   return $self;
  132. }
  133.  
  134.  
  135.  
  136. sub _process {
  137.   #
  138.   # call _read() and _parse() on the given config
  139.   my($self) = @_;
  140.  
  141.   if ($self->{DefaultConfig} && $self->{InterPolateVars}) {
  142.     $self->{DefaultConfig} = $self->_interpolate_hash($self->{DefaultConfig}); # FIXME: _hashref() ?
  143.   }
  144.   if (exists $self->{StringContent}) {
  145.     # consider the supplied string as config file
  146.     $self->_read($self->{StringContent}, 'SCALAR');
  147.     $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
  148.   }
  149.   elsif (exists $self->{ConfigHash}) {
  150.     if (ref($self->{ConfigHash}) eq 'HASH') {
  151.       # initialize with given hash
  152.       $self->{config} = $self->{ConfigHash};
  153.       $self->{parsed} = 1;
  154.     }
  155.     else {
  156.       croak "Config::General: Parameter -ConfigHash must be a hash reference!\n";
  157.     }
  158.   }
  159.   elsif (ref($self->{ConfigFile}) eq 'GLOB' || ref($self->{ConfigFile}) eq 'FileHandle') {
  160.     # use the file the glob points to
  161.     $self->_read($self->{ConfigFile});
  162.     $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
  163.   }
  164.   else {
  165.     if ($self->{ConfigFile}) {
  166.       # open the file and read the contents in
  167.       $self->{configfile} = $self->{ConfigFile};
  168.       if ( file_name_is_absolute($self->{ConfigFile}) ) {
  169.     # look if is is an absolute path and save the basename if it is absolute
  170.     my ($volume, $path, undef) = splitpath($self->{ConfigFile});
  171.     $path =~ s#/$##; # remove eventually existing trailing slash
  172.     if (! $self->{ConfigPath}) {
  173.       $self->{ConfigPath} = [];
  174.     }
  175.     unshift @{$self->{ConfigPath}}, catpath($volume, $path, q());
  176.       }
  177.       $self->_open($self->{configfile});
  178.       # now, we parse immdediately, getall simply returns the whole hash
  179.       $self->{config} = $self->_hashref();
  180.       $self->{config} = $self->_parse($self->{DefaultConfig}, $self->{content});
  181.     }
  182.     else {
  183.       # hm, no valid config file given, so try it as an empty object
  184.       $self->{config} = $self->_hashref();
  185.       $self->{parsed} = 1;
  186.     }
  187.   }
  188. }
  189.  
  190.  
  191. sub _blessoop {
  192.   #
  193.   # bless into ::Extended if neccessary
  194.   my($self) = @_;
  195.   if ($self->{ExtendedAccess}) {
  196.     # we are blessing here again, to get into the ::Extended namespace
  197.     # for inheriting the methods available overthere, which we doesn't have.
  198.     bless $self, 'Config::General::Extended';
  199.     eval {
  200.       require Config::General::Extended;
  201.     };
  202.     if ($EVAL_ERROR) {
  203.       croak "Config::General: " . $EVAL_ERROR;
  204.     }
  205.   }
  206. #  return $self;
  207. }
  208.  
  209. sub _blessvars {
  210.   #
  211.   # bless into ::Interpolated if neccessary
  212.   my($self) = @_;
  213.   if ($self->{InterPolateVars} || $self->{InterPolateEnv}) {
  214.     # InterPolateEnv implies InterPolateVars
  215.     $self->{InterPolateVars} = 1;
  216.  
  217.     # we are blessing here again, to get into the ::InterPolated namespace
  218.     # for inheriting the methods available overthere, which we doesn't have here.
  219.     bless $self, 'Config::General::Interpolated';
  220.     eval {
  221.       require Config::General::Interpolated;
  222.     };
  223.     if ($EVAL_ERROR) {
  224.       croak "Config::General: " . $EVAL_ERROR;
  225.     }
  226.     # pre-compile the variable regexp
  227.     $self->{regex} = $self->_set_regex();
  228.   }
  229. #  return $self;
  230. }
  231.  
  232.  
  233. sub _splitpolicy {
  234.   #
  235.   # find out what split policy to use
  236.   my($self) = @_;
  237.   if ($self->{SplitPolicy} ne 'guess') {
  238.     if ($self->{SplitPolicy} eq 'whitespace') {
  239.       $self->{SplitDelimiter} = '\s+';
  240.       if (!$self->{StoreDelimiter}) {
  241.     $self->{StoreDelimiter} = q(   );
  242.       }
  243.     }
  244.     elsif ($self->{SplitPolicy} eq 'equalsign') {
  245.       $self->{SplitDelimiter} = '\s*=\s*';
  246.       if (!$self->{StoreDelimiter}) {
  247.     $self->{StoreDelimiter} = ' = ';
  248.       }
  249.     }
  250.     elsif ($self->{SplitPolicy} eq 'custom') {
  251.       if (! $self->{SplitDelimiter} ) {
  252.     croak "Config::General: SplitPolicy set to 'custom' but no SplitDelimiter set.\n";
  253.       }
  254.     }
  255.     else {
  256.       croak "Config::General: Unsupported SplitPolicy: $self->{SplitPolicy}.\n";
  257.     }
  258.   }
  259.   else {
  260.     if (!$self->{StoreDelimiter}) {
  261.       $self->{StoreDelimiter} = q(   );
  262.     }
  263.   }
  264. }
  265.  
  266. sub _prepare {
  267.   #
  268.   # prepare the class parameters, mangle them, if there
  269.   # are options to reset or to override, do it here.
  270.   my ($self, %conf) = @_;
  271.  
  272.   # save the parameter list for ::Extended's new() calls
  273.   $self->{Params} = \%conf;
  274.  
  275.   # be backwards compatible
  276.   if (exists $conf{-file}) {
  277.     $self->{ConfigFile} = delete $conf{-file};
  278.   }
  279.   if (exists $conf{-hash}) {
  280.     $self->{ConfigHash} = delete $conf{-hash};
  281.   }
  282.  
  283.   # store input, file, handle, or array
  284.   if (exists $conf{-ConfigFile}) {
  285.     $self->{ConfigFile} = delete $conf{-ConfigFile};
  286.   }
  287.   if (exists $conf{-ConfigHash}) {
  288.     $self->{ConfigHash} = delete $conf{-ConfigHash};
  289.   }
  290.  
  291.   # store search path for relative configs, if any
  292.   if (exists $conf{-ConfigPath}) {
  293.     my $configpath = delete $conf{-ConfigPath};
  294.     $self->{ConfigPath} = ref $configpath eq 'ARRAY' ? $configpath : [$configpath];
  295.   }
  296.  
  297.   # handle options which contains values we need (strings, hashrefs or the like)
  298.   if (exists $conf{-String} ) {
  299.     #if (ref(\$conf{-String}) eq 'SCALAR') {
  300.     if (not ref $conf{-String}) {
  301.       if ( $conf{-String}) {
  302.     $self->{StringContent} = $conf{-String};
  303.       }
  304.       delete $conf{-String};
  305.     }
  306.     # re-implement arrayref support, removed after 2.22 as _read were
  307.     # re-organized
  308.     # fixed bug#33385
  309.     elsif(ref($conf{-String}) eq 'ARRAY') {
  310.       $self->{StringContent} = join "\n", @{$conf{-String}};
  311.     }
  312.     else {
  313.       croak "Config::General: Parameter -String must be a SCALAR or ARRAYREF!\n";
  314.     }
  315.     delete $conf{-String};
  316.   }
  317.   if (exists $conf{-Tie}) {
  318.     if ($conf{-Tie}) {
  319.       $self->{Tie} = delete $conf{-Tie};
  320.       $self->{DefaultConfig} = $self->_hashref();
  321.     }
  322.   }
  323.  
  324.   if (exists $conf{-FlagBits}) {
  325.     if ($conf{-FlagBits} && ref($conf{-FlagBits}) eq 'HASH') {
  326.       $self->{FlagBits} = 1;
  327.       $self->{FlagBitsFlags} = $conf{-FlagBits};
  328.     }
  329.     delete $conf{-FlagBits};
  330.   }
  331.  
  332.   if (exists $conf{-DefaultConfig}) {
  333.     if ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq 'HASH') {
  334.       $self->{DefaultConfig} = $conf{-DefaultConfig};
  335.     }
  336.     elsif ($conf{-DefaultConfig} && ref($conf{-DefaultConfig}) eq q()) {
  337.       $self->_read($conf{-DefaultConfig}, 'SCALAR');
  338.       $self->{DefaultConfig} = $self->_parse($self->_hashref(), $self->{content});
  339.       $self->{content} = ();
  340.     }
  341.     delete $conf{-DefaultConfig};
  342.   }
  343.  
  344.   # handle options which may either be true or false
  345.   # allowing "human" logic about what is true and what is not
  346.   foreach my $entry (keys %conf) {
  347.     my $key = $entry;
  348.     $key =~ s/^\-//;
  349.     if (! exists $self->{$key}) {
  350.       croak "Config::General: Unknown parameter: $entry => \"$conf{$entry}\" (key: <$key>)\n";
  351.     }
  352.     if ($conf{$entry} =~ /$self->{AutoTrueFlags}->{true}/io) {
  353.       $self->{$key} = 1;
  354.     }
  355.     elsif ($conf{$entry} =~ /$self->{AutoTrueFlags}->{false}/io) {
  356.       $self->{$key} = 0;
  357.     }
  358.     else {
  359.       # keep it untouched
  360.       $self->{$key} = $conf{$entry};
  361.     }
  362.   }
  363.  
  364.   if ($self->{MergeDuplicateOptions}) {
  365.     # override if not set by user
  366.     if (! exists $conf{-AllowMultiOptions}) {
  367.       $self->{AllowMultiOptions} = 0;
  368.     }
  369.   }
  370.  
  371.   if ($self->{ApacheCompatible}) {
  372.     # turn on all apache compatibility options which has
  373.     # been incorporated during the years...
  374.     $self->{UseApacheInclude}   = 1;
  375.     $self->{IncludeRelative}    = 1;
  376.     $self->{IncludeDirectories} = 1;
  377.     $self->{IncludeGlob}        = 1;
  378.     $self->{SlashIsDirectory}   = 1;
  379.     $self->{SplitPolicy}        = 'whitespace';
  380.     $self->{CComments}          = 0;
  381.   }
  382. }
  383.  
  384. sub getall {
  385.   #
  386.   # just return the whole config hash
  387.   #
  388.   my($this) = @_;
  389.   return (exists $this->{config} ? %{$this->{config}} : () );
  390. }
  391.  
  392.  
  393. sub files {
  394.   #
  395.   # return a list of files opened so far
  396.   #
  397.   my($this) = @_;
  398.   return (exists $this->{files} ? keys %{$this->{files}} : () );
  399. }
  400.  
  401.  
  402. sub _open {
  403.   #
  404.   # open the config file, or expand a directory or glob
  405.   #
  406.   my($this, $basefile, $basepath) = @_;
  407.   my($fh, $configfile);
  408.  
  409.   if($basepath) {
  410.     # if this doesn't work we can still try later the global config path to use
  411.     $configfile = catfile($basepath, $basefile);
  412.   }
  413.   else {
  414.     $configfile = $basefile;
  415.   }
  416.  
  417.   if ($this->{IncludeGlob} and $configfile =~ /[*?\[\{\\]/) {
  418.     # Something like: *.conf (or maybe dir/*.conf) was included; expand it and
  419.     # pass each expansion through this method again.
  420.     my @include = grep { -f $_ } bsd_glob($configfile, GLOB_BRACE | GLOB_QUOTE);
  421.  
  422.     # applied patch by AlexK fixing rt.cpan.org#41030
  423.     if ( !@include && defined $this->{ConfigPath} ) {
  424.         foreach my $dir (@{$this->{ConfigPath}}) {
  425.         my ($volume, $path, undef) = splitpath($basefile);
  426.         if ( -d catfile( $dir, $path )  ) {
  427.                 push @include, grep { -f $_ } bsd_glob(catfile($dir, $basefile), GLOB_BRACE | GLOB_QUOTE);
  428.             last;
  429.         }
  430.         }
  431.     }
  432.  
  433.     if (@include == 1) {
  434.       $configfile = $include[0];
  435.     }
  436.     else {
  437.       # Multiple results or no expansion results (which is fine,
  438.       # include foo/* shouldn't fail if there isn't anything matching)
  439.       local $this->{IncludeGlob};
  440.       for (@include) {
  441.     $this->_open($_);
  442.       }
  443.       return;
  444.     }
  445.   }
  446.  
  447.   if (!-e $configfile) {
  448.     my $found;
  449.     if (defined $this->{ConfigPath}) {
  450.       # try to find the file within ConfigPath
  451.       foreach my $dir (@{$this->{ConfigPath}}) {
  452.     if( -e catfile($dir, $basefile) ) {
  453.       $configfile = catfile($dir, $basefile);
  454.       $found = 1;
  455.       last; # found it
  456.     }
  457.       }
  458.     }
  459.     if (!$found) {
  460.       my $path_message = defined $this->{ConfigPath} ? q( within ConfigPath: ) . join(q(.), @{$this->{ConfigPath}}) : q();
  461.       croak qq{Config::General The file "$basefile" does not exist$path_message!};
  462.     }
  463.   }
  464.  
  465.   local ($RS) = $RS;
  466.   if (! $RS) {
  467.     carp(q(\$RS (INPUT_RECORD_SEPARATOR) is undefined.  Guessing you want a line feed character));
  468.     $RS = "\n";
  469.   }
  470.  
  471.   if (-d $configfile and $this->{IncludeDirectories}) {
  472.     # A directory was included; include all the files inside that directory in ASCII order
  473.     local *INCLUDEDIR;
  474.     opendir INCLUDEDIR, $configfile or croak "Config::General: Could not open directory $configfile!($!)\n";
  475.     my @files = sort grep { -f catfile($configfile, $_) } catfile($configfile, $_), readdir INCLUDEDIR;
  476.     closedir INCLUDEDIR;
  477.     local $this->{CurrentConfigFilePath} = $configfile;
  478.     for (@files) {
  479.       my $file = catfile($configfile, $_);
  480.       if (! exists $this->{files}->{$file} or $this->{IncludeAgain} ) {
  481.         # support re-read if used urged us to do so, otherwise ignore the file
  482.     if ($this->{UTF8}) {
  483.       $fh = new IO::File;
  484.       open( $fh, "<:utf8", $file)
  485.         or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
  486.     }
  487.     else {
  488.       $fh = IO::File->new( $file, 'r') or croak "Config::General: Could not open $file!($!)\n";
  489.     }
  490.     $this->{files}->{"$file"} = 1;
  491.     $this->_read($fh);
  492.       }
  493.       else {
  494.         warn "File $file already loaded.  Use -IncludeAgain to load it again.\n";
  495.       }
  496.     }
  497.   }
  498.   elsif (-e _) {
  499.     if (exists $this->{files}->{$configfile} and not $this->{IncludeAgain}) {
  500.       # do not read the same file twice, just return
  501.       warn "File $configfile already loaded.  Use -IncludeAgain to load it again.\n";
  502.       return;
  503.     }
  504.     else {
  505.       if ($this->{UTF8}) {
  506.     $fh = new IO::File;
  507.     open( $fh, "<:utf8", $configfile)
  508.       or croak "Config::General: Could not open $configfile in UTF8 mode!($!)\n";
  509.       }
  510.       else {
  511.     $fh = IO::File->new( "$configfile", 'r')
  512.       or croak "Config::General: Could not open $configfile!($!)\n";
  513.       }
  514.  
  515.       $this->{files}->{$configfile}    = 1;
  516.  
  517.       my ($volume, $path, undef)           = splitpath($configfile);
  518.       local $this->{CurrentConfigFilePath} = catpath($volume, $path, q());
  519.  
  520.       $this->_read($fh);
  521.     }
  522.   }
  523.   return;
  524. }
  525.  
  526.  
  527. sub _read {
  528.   #
  529.   # store the config contents in @content
  530.   # and prepare it somewhat for easier parsing later
  531.   # (comments, continuing lines, and stuff)
  532.   #
  533.   my($this, $fh, $flag) = @_;
  534.   my(@stuff, @content, $c_comment, $longline, $hier, $hierend, @hierdoc);
  535.   local $_ = q();
  536.  
  537.   if ($flag && $flag eq 'SCALAR') {
  538.     if (ref($fh) eq 'ARRAY') {
  539.       @stuff = @{$fh};
  540.     }
  541.     else {
  542.       @stuff = split /\n/, $fh;
  543.     }
  544.   }
  545.   else {
  546.     @stuff = <$fh>;
  547.   }
  548.  
  549.   foreach (@stuff) {
  550.     if ($this->{AutoLaunder}) {
  551.       if (m/^(.*)$/) {
  552.     $_ = $1;
  553.       }
  554.     }
  555.  
  556.     chomp;
  557.  
  558.     if ($this->{CComments}) {
  559.       # look for C-Style comments, if activated
  560.       if (/(\s*\/\*.*\*\/\s*)/) {
  561.     # single c-comment on one line
  562.     s/\s*\/\*.*\*\/\s*//;
  563.       }
  564.       elsif (/^\s*\/\*/) {
  565.     # the beginning of a C-comment ("/*"), from now on ignore everything.
  566.     if (/\*\/\s*$/) {
  567.       # C-comment end is already there, so just ignore this line!
  568.       $c_comment = 0;
  569.     }
  570.     else {
  571.       $c_comment = 1;
  572.     }
  573.       }
  574.       elsif (/\*\//) {
  575.     if (!$c_comment) {
  576.       warn "invalid syntax: found end of C-comment without previous start!\n";
  577.     }
  578.     $c_comment = 0;    # the current C-comment ends here, go on
  579.     s/^.*\*\///;       # if there is still stuff, it will be read
  580.       }
  581.       next if($c_comment); # ignore EVERYTHING from now on, IF it IS a C-Comment
  582.     }
  583.  
  584.  
  585.     if ($hier) {
  586.       # inside here-doc, only look for $hierend marker
  587.       if (/^(\s*)\Q$hierend\E\s*$/) {
  588.     my $indent = $1;                 # preserve indentation
  589.     $hier .= ' ' . $this->{EOFseparator}; # bugfix of rt.40925
  590.                                      # _parse will also preserver indentation
  591.     if ($indent) {
  592.       foreach (@hierdoc) {
  593.         s/^$indent//;                # i.e. the end was: "    EOF" then we remove "    " from every here-doc line
  594.         $hier .= $_ . "\n";          # and store it in $hier
  595.       }
  596.     }
  597.     else {
  598.       $hier .= join "\n", @hierdoc;  # there was no indentation of the end-string, so join it 1:1
  599.     }
  600.     push @{$this->{content}}, $hier; # push it onto the content stack
  601.     @hierdoc = ();
  602.     undef $hier;
  603.     undef $hierend;
  604.       }
  605.       else {
  606.     # everything else onto the stack
  607.     push @hierdoc, $_;
  608.       }
  609.       next;
  610.     }
  611.  
  612.     ###
  613.     ### non-heredoc entries from now on
  614.     ##
  615.  
  616.     # Remove comments and empty lines
  617.     s/(?<!\\)#.*$//; # .+ => .* bugfix rt.cpan.org#44600
  618.     next if /^\s*#/;
  619.     next if /^\s*$/;
  620.  
  621.  
  622.     # look for multiline option, indicated by a trailing backslash
  623.     #my $extra = $this->{BackslashEscape} ? '(?<!\\\\)' : q();
  624.     #if (/$extra\\$/) {
  625.     if (/(?<!\\)\\$/) {
  626.       chop;
  627.       s/^\s*//;
  628.       $longline .= $_;
  629.       next;
  630.     }
  631.  
  632.     # remove the \ from all characters if BackslashEscape is turned on
  633.     # FIXME (rt.cpan.org#33218
  634.     #if ($this->{BackslashEscape}) {
  635.     #  s/\\(.)/$1/g;
  636.     #}
  637.     #else {
  638.     #  # remove the \ char in front of masked "#", if any
  639.     #  s/\\#/#/g;
  640.     #}
  641.  
  642.  
  643.     # transform explicit-empty blocks to conforming blocks
  644.     if (!$this->{ApacheCompatible} && /\s*<([^\/]+?.*?)\/>$/) {
  645.       my $block = $1;
  646.       if ($block !~ /\"/) {
  647.     if ($block !~ /\s[^\s]/) {
  648.       # fix of bug 7957, add quotation to pure slash at the
  649.       # end of a block so that it will be considered as directory
  650.       # unless the block is already quoted or contains whitespaces
  651.       # and no quotes.
  652.       if ($this->{SlashIsDirectory}) {
  653.         push @{$this->{content}}, '<' . $block . '"/">';
  654.         next;
  655.       }
  656.     }
  657.       }
  658.       my $orig  = $_;
  659.       $orig     =~ s/\/>$/>/;
  660.       $block    =~ s/\s\s*.*$//;
  661.       push @{$this->{content}}, $orig, "</${block}>";
  662.       next;
  663.     }
  664.  
  665.  
  666.     # look for here-doc identifier
  667.     if ($this->{SplitPolicy} eq 'guess') {
  668.       if (/^\s*([^=]+?)\s*=\s*<<\s*(.+?)\s*$/) {
  669.     # try equal sign (fix bug rt#36607)
  670.     $hier    = $1;  # the actual here-doc variable name
  671.     $hierend = $2;  # the here-doc identifier, i.e. "EOF"
  672.     next;
  673.       }
  674.       elsif (/^\s*(\S+?)\s+<<\s*(.+?)\s*$/) {
  675.     # try whitespace
  676.     $hier    = $1;  # the actual here-doc variable name
  677.     $hierend = $2;  # the here-doc identifier, i.e. "EOF"
  678.     next;
  679.       }
  680.     }
  681.     else {
  682.       # no guess, use one of the configured strict split policies
  683.       if (/^\s*(.+?)($this->{SplitDelimiter})<<\s*(.+?)\s*$/) {
  684.     $hier    = $1;  # the actual here-doc variable name
  685.     $hierend = $3;  # the here-doc identifier, i.e. "EOF"
  686.     next;
  687.       }
  688.     }
  689.  
  690.  
  691.  
  692.     ###
  693.     ### any "normal" config lines from now on
  694.     ###
  695.  
  696.     if ($longline) {
  697.       # previous stuff was a longline and this is the last line of the longline
  698.       s/^\s*//;
  699.       $longline .= $_;
  700.       push @{$this->{content}}, $longline;    # push it onto the content stack
  701.       undef $longline;
  702.       next;
  703.     }
  704.     else {
  705.       # look for include statement(s)
  706.       my $incl_file;
  707.       my $path = '';
  708.       if ( $this->{IncludeRelative} and defined $this->{CurrentConfigFilePath}) {
  709.           $path = $this->{CurrentConfigFilePath};
  710.       }
  711.       elsif (defined $this->{ConfigPath}) {
  712.     # fetch pathname of base config file, assuming the 1st one is the path of it
  713.     $path = $this->{ConfigPath}->[0];
  714.       }
  715.  
  716.       # bugfix rt.cpan.org#38635: support quoted filenames
  717.       if ($this->{UseApacheInclude}) {
  718.          if (/^\s*include\s*(["'])(.*?)(?<!\\)\1$/i) {
  719.            $incl_file = $2;
  720.          }
  721.          elsif (/^\s*include\s+(.+?)\s*$/i) {
  722.            $incl_file = $1;
  723.          }
  724.       }
  725.       else {
  726.         if (/^\s*<<include\s+(.+?)>>\s*$/i) {
  727.           $incl_file = $1;
  728.         }
  729.       }
  730.  
  731.       if ($incl_file) {
  732.     if ( $this->{IncludeRelative} && $path && !file_name_is_absolute($incl_file) ) {
  733.       # include the file from within location of $this->{configfile}
  734.       $this->_open( $incl_file, $path );
  735.     }
  736.     else {
  737.       # include the file from within pwd, or absolute
  738.       $this->_open($incl_file);
  739.     }
  740.       }
  741.       else {
  742.     # standard entry, (option = value)
  743.     push @{$this->{content}}, $_;
  744.       }
  745.  
  746.     }
  747.  
  748.   }
  749.   return 1;
  750. }
  751.  
  752.  
  753.  
  754.  
  755.  
  756. sub _parse {
  757.   #
  758.   # parse the contents of the file
  759.   #
  760.   my($this, $config, $content) = @_;
  761.   my(@newcontent, $block, $blockname, $chunk,$block_level);
  762.   local $_;
  763.  
  764.   foreach (@{$content}) {                                  # loop over content stack
  765.     chomp;
  766.     $chunk++;
  767.     $_ =~ s/^\s+//;                                        # strip spaces @ end and begin
  768.     $_ =~ s/\s+$//;
  769.  
  770.     #
  771.     # build option value assignment, split current input
  772.     # using whitespace, equal sign or optionally here-doc
  773.     # separator EOFseparator
  774.     my ($option,$value);
  775.     if (/$this->{EOFseparator}/) {
  776.       ($option,$value) = split /\s*$this->{EOFseparator}\s*/, $_, 2;   # separated by heredoc-finding in _open()
  777.     }
  778.     else {
  779.       if ($this->{SplitPolicy} eq 'guess') {
  780.     # again the old regex. use equalsign SplitPolicy to get the
  781.     # 2.00 behavior. the new regexes were too odd.
  782.     ($option,$value) = split /\s*=\s*|\s+/, $_, 2;
  783.       }
  784.       else {
  785.     # no guess, use one of the configured strict split policies
  786.     ($option,$value) = split /$this->{SplitDelimiter}/, $_, 2;
  787.       }
  788.     }
  789.  
  790.     if ($value && $value =~ /^"/ && $value =~ /"$/) {
  791.       $value =~ s/^"//;                                    # remove leading and trailing "
  792.       $value =~ s/"$//;
  793.     }
  794.     if (! defined $block) {                                # not inside a block @ the moment
  795.       if (/^<([^\/]+?.*?)>$/) {                            # look if it is a block
  796.     $block = $1;                                       # store block name
  797.     if ($block =~ /^"([^"]+)"$/) {
  798.       # quoted block, unquote it and do not split
  799.       $block =~ s/"//g;
  800.     }
  801.     else {
  802.       # If it is a named block store the name separately; allow the block and name to each be quoted
  803.       if ($block =~ /^(?:"([^"]+)"|(\S+))(?:\s+(?:"([^"]+)"|(.*)))?$/) {
  804.         $block = $1 || $2;
  805.         $blockname = $3 || $4;
  806.       }
  807.     }
  808.     if ($this->{InterPolateVars}) {
  809.       # interpolate block(name), add "<" and ">" to the key, because
  810.       # it is sure that such keys does not exist otherwise.
  811.       $block     = $this->_interpolate($config, "<$block>", $block);
  812.       if (defined $blockname) {
  813.         $blockname = $this->_interpolate($config, "<$blockname>", "$blockname");
  814.       }
  815.     }
  816.     if ($this->{LowerCaseNames}) {
  817.       $block = lc $block;    # only for blocks lc(), if configured via new()
  818.     }
  819.     $this->{level} += 1;
  820.     undef @newcontent;
  821.     next;
  822.       }
  823.       elsif (/^<\/(.+?)>$/) { # it is an end block, but we don't have a matching block!
  824.     croak "Config::General: EndBlock \"<\/$1>\" has no StartBlock statement (level: $this->{level}, chunk $chunk)!\n";
  825.       }
  826.       else {                                               # insert key/value pair into actual node
  827.     if ($this->{LowerCaseNames}) {
  828.       $option = lc $option;
  829.     }
  830.  
  831.     if (exists $config->{$option}) {
  832.       if ($this->{MergeDuplicateOptions}) {
  833.         $config->{$option} = $this->_parse_value($config, $option, $value);
  834.  
  835.         # bugfix rt.cpan.org#33216
  836.         if ($this->{InterPolateVars}) {
  837.           # save pair on local stack
  838.           $config->{__stack}->{$option} = $config->{$option};
  839.         }
  840.       }
  841.       else {
  842.         if (! $this->{AllowMultiOptions} ) {
  843.           # no, duplicates not allowed
  844.           croak "Config::General: Option \"$option\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
  845.         }
  846.         else {
  847.           # yes, duplicates allowed
  848.           if (ref($config->{$option}) ne 'ARRAY') {      # convert scalar to array
  849.         my $savevalue = $config->{$option};
  850.         delete $config->{$option};
  851.         push @{$config->{$option}}, $savevalue;
  852.           }
  853.           eval {
  854.         # check if arrays are supported by the underlying hash
  855.         my $i = scalar @{$config->{$option}};
  856.           };
  857.           if ($EVAL_ERROR) {
  858.         $config->{$option} = $this->_parse_value($config, $option, $value);
  859.           }
  860.           else {
  861.         # it's already an array, just push
  862.         push @{$config->{$option}}, $this->_parse_value($config, $option, $value);
  863.           }
  864.         }
  865.       }
  866.     }
  867.     else {
  868.           if($this->{ForceArray} && $value =~ /^\[\s*(.+?)\s*\]$/) {
  869.             # force single value array entry
  870.             push @{$config->{$option}}, $this->_parse_value($config, $option, $1);
  871.           }
  872.           else {
  873.         # standard config option, insert key/value pair into node
  874.         $config->{$option} = $this->_parse_value($config, $option, $value);
  875.  
  876.         if ($this->{InterPolateVars}) {
  877.           # save pair on local stack
  878.           $config->{__stack}->{$option} = $config->{$option};
  879.         }
  880.           }
  881.     }
  882.       }
  883.     }
  884.     elsif (/^<([^\/]+?.*?)>$/) {    # found a start block inside a block, don't forget it
  885.       $block_level++;               # $block_level indicates wether we are still inside a node
  886.       push @newcontent, $_;         # push onto new content stack for later recursive call of _parse()
  887.     }
  888.     elsif (/^<\/(.+?)>$/) {
  889.       if ($block_level) {           # this endblock is not the one we are searching for, decrement and push
  890.     $block_level--;             # if it is 0, then the endblock was the one we searched for, see below
  891.     push @newcontent, $_;       # push onto new content stack
  892.       }
  893.       else {                        # calling myself recursively, end of $block reached, $block_level is 0
  894.     if (defined $blockname) {
  895.       # a named block, make it a hashref inside a hash within the current node
  896.  
  897.       if (! exists $config->{$block}) {
  898.         # Make sure that the hash is not created implicitly
  899.         $config->{$block} = $this->_hashref();
  900.  
  901.         if ($this->{InterPolateVars}) {
  902.           # inherit current __stack to new block
  903.           $config->{$block}->{__stack} = $this->_copy($config->{__stack});
  904.         }
  905.       }
  906.  
  907.       if (ref($config->{$block}) eq '') {
  908.         croak "Config::General: Block <$block> already exists as scalar entry!\n";
  909.       }
  910.       elsif (ref($config->{$block}) eq 'ARRAY') {
  911.         croak "Config::General: Cannot append named block <$block $blockname> to array of scalars!\n"
  912.              ."Block <$block> or scalar '$block' occurs more than once.\n"
  913.              ."Turn on -MergeDuplicateBlocks or make sure <$block> occurs only once in the config.\n";
  914.       }
  915.       elsif (exists $config->{$block}->{$blockname}) {
  916.         # the named block already exists, make it an array
  917.         if ($this->{MergeDuplicateBlocks}) {
  918.           # just merge the new block with the same name as an existing one into
  919.               # this one.
  920.           $config->{$block}->{$blockname} = $this->_parse($config->{$block}->{$blockname}, \@newcontent);
  921.         }
  922.         else {
  923.           if (! $this->{AllowMultiOptions}) {
  924.         croak "Config::General: Named block \"<$block $blockname>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
  925.           }
  926.           else {                                       # preserve existing data
  927.         my $savevalue = $config->{$block}->{$blockname};
  928.         delete $config->{$block}->{$blockname};
  929.         my @ar;
  930.         if (ref $savevalue eq 'ARRAY') {
  931.           push @ar, @{$savevalue};                   # preserve array if any
  932.         }
  933.         else {
  934.           push @ar, $savevalue;
  935.         }
  936.         push @ar, $this->_parse( $this->_hashref(), \@newcontent);  # append it
  937.         $config->{$block}->{$blockname} = \@ar;
  938.           }
  939.         }
  940.       }
  941.       else {
  942.         # the first occurence of this particular named block
  943.         my $tmphash = $this->_hashref();
  944.  
  945.         if ($this->{InterPolateVars}) {
  946.           # inherit current __stack to new block
  947.           $tmphash->{__stack} = $this->_copy($config->{__stack});
  948.           #$tmphash->{__stack} = $config->{$block}->{__stack};
  949.         }
  950.  
  951.         $config->{$block}->{$blockname} = $this->_parse($tmphash, \@newcontent);
  952.       }
  953.     }
  954.     else {
  955.       # standard block
  956.       if (exists $config->{$block}) {
  957.         if (ref($config->{$block}) eq '') {
  958.           croak "Config::General: Cannot create hashref from <$block> because there is\n"
  959.            ."already a scalar option '$block' with value '$config->{$block}'\n";
  960.         }
  961.  
  962.         # the block already exists, make it an array
  963.         if ($this->{MergeDuplicateBlocks}) {
  964.           # just merge the new block with the same name as an existing one into
  965.               # this one.
  966.           $config->{$block} = $this->_parse($config->{$block}, \@newcontent);
  967.             }
  968.             else {
  969.           if (! $this->{AllowMultiOptions}) {
  970.             croak "Config::General: Block \"<$block>\" occurs more than once (level: $this->{level}, chunk $chunk)!\n";
  971.           }
  972.           else {
  973.         my $savevalue = $config->{$block};
  974.         delete $config->{$block};
  975.         my @ar;
  976.         if (ref $savevalue eq "ARRAY") {
  977.           push @ar, @{$savevalue};
  978.         }
  979.         else {
  980.           push @ar, $savevalue;
  981.         }
  982.  
  983.         # fixes rt#31529
  984.         my $tmphash = $this->_hashref();
  985.         if ($this->{InterPolateVars}) {
  986.           # inherit current __stack to new block
  987.           $tmphash->{__stack} = $this->_copy($config->{__stack});
  988.         }
  989.  
  990.         push @ar, $this->_parse( $tmphash, \@newcontent);
  991.  
  992.         $config->{$block} = \@ar;
  993.           }
  994.         }
  995.       }
  996.       else {
  997.         # the first occurence of this particular block
  998.         my $tmphash = $this->_hashref();
  999.  
  1000.         if ($this->{InterPolateVars}) {
  1001.           # inherit current __stack to new block
  1002.           $tmphash->{__stack} = $this->_copy($config->{__stack});
  1003.         }
  1004.  
  1005.         $config->{$block} = $this->_parse($tmphash, \@newcontent);
  1006.       }
  1007.     }
  1008.     undef $blockname;
  1009.     undef $block;
  1010.     $this->{level} -= 1;
  1011.     next;
  1012.       }
  1013.     }
  1014.     else { # inside $block, just push onto new content stack
  1015.       push @newcontent, $_;
  1016.     }
  1017.   }
  1018.   if ($block) {
  1019.     # $block is still defined, which means, that it had
  1020.     # no matching endblock!
  1021.     croak "Config::General: Block \"<$block>\" has no EndBlock statement (level: $this->{level}, chunk $chunk)!\n";
  1022.   }
  1023.   return $config;
  1024. }
  1025.  
  1026.  
  1027. sub _copy {
  1028.   #
  1029.   # copy the contents of one hash into another
  1030.   # to circumvent invalid references
  1031.   # fixes rt.cpan.org bug #35122
  1032.   my($this, $source) = @_;
  1033.   my %hash = ();
  1034.   while (my ($key, $value) = each %{$source}) {
  1035.     $hash{$key} = $value;
  1036.   }
  1037.   return \%hash;
  1038. }
  1039.  
  1040.  
  1041. sub _parse_value {
  1042.   #
  1043.   # parse the value if value parsing is turned on
  1044.   # by either -AutoTrue and/or -FlagBits
  1045.   # otherwise just return the given value unchanged
  1046.   #
  1047.   my($this, $config, $option, $value) =@_;
  1048.  
  1049.   # avoid "Use of uninitialized value"
  1050.   if (! defined $value) {
  1051.     # patch fix rt#54583
  1052.     # Return an input undefined value without trying transformations
  1053.     return $value;
  1054.   }
  1055.  
  1056.   if ($this->{InterPolateVars}) {
  1057.     $value = $this->_interpolate($config, $option, $value);
  1058.   }
  1059.  
  1060.   # make true/false values to 1 or 0 (-AutoTrue)
  1061.   if ($this->{AutoTrue}) {
  1062.     if ($value =~ /$this->{AutoTrueFlags}->{true}/io) {
  1063.       $value = 1;
  1064.     }
  1065.     elsif ($value =~ /$this->{AutoTrueFlags}->{false}/io) {
  1066.       $value = 0;
  1067.     }
  1068.   }
  1069.  
  1070.   # assign predefined flags or undef for every flag | flag ... (-FlagBits)
  1071.   if ($this->{FlagBits}) {
  1072.     if (exists $this->{FlagBitsFlags}->{$option}) {
  1073.       my %__flags = map { $_ => 1 } split /\s*\|\s*/, $value;
  1074.       foreach my $flag (keys %{$this->{FlagBitsFlags}->{$option}}) {
  1075.     if (exists $__flags{$flag}) {
  1076.       $__flags{$flag} = $this->{FlagBitsFlags}->{$option}->{$flag};
  1077.     }
  1078.     else {
  1079.       $__flags{$flag} = undef;
  1080.     }
  1081.       }
  1082.       $value = \%__flags;
  1083.     }
  1084.   }
  1085.  
  1086.   # are there any escaped characters left? put them out as is
  1087.   $value =~ s/\\([\$\\\"])/$1/g;
  1088.  
  1089.   return $value;
  1090. }
  1091.  
  1092.  
  1093.  
  1094.  
  1095.  
  1096.  
  1097. sub NoMultiOptions {
  1098.   #
  1099.   # turn AllowMultiOptions off, still exists for backward compatibility.
  1100.   # Since we do parsing from within new(), we must
  1101.   # call it again if one turns NoMultiOptions on!
  1102.   #
  1103.   croak q(Config::General: The NoMultiOptions() method is deprecated. Set 'AllowMultiOptions' to 'no' instead!);
  1104. }
  1105.  
  1106.  
  1107. sub save {
  1108.   #
  1109.   # this is the old version of save() whose API interface
  1110.   # has been changed. I'm very sorry 'bout this.
  1111.   #
  1112.   # I'll try to figure out, if it has been called correctly
  1113.   # and if yes, feed the call to Save(), otherwise croak.
  1114.   #
  1115.   my($this, $one, @two) = @_;
  1116.  
  1117.   if ( (@two && $one) && ( (scalar @two) % 2 == 0) ) {
  1118.     # @two seems to be a hash
  1119.     my %h = @two;
  1120.     $this->save_file($one, \%h);
  1121.   }
  1122.   else {
  1123.     croak q(Config::General: The save() method is deprecated. Use the new save_file() method instead!);
  1124.   }
  1125.   return;
  1126. }
  1127.  
  1128.  
  1129. sub save_file {
  1130.   #
  1131.   # save the config back to disk
  1132.   #
  1133.   my($this, $file, $config) = @_;
  1134.   my $fh;
  1135.   my $config_string;
  1136.  
  1137.   if (!$file) {
  1138.     croak "Config::General: Filename is required!";
  1139.   }
  1140.   else {
  1141.     if ($this->{UTF8}) {
  1142.       $fh = new IO::File;
  1143.       open($fh, ">:utf8", $file)
  1144.     or croak "Config::General: Could not open $file in UTF8 mode!($!)\n";
  1145.     }
  1146.     else {
  1147.       $fh = IO::File->new( "$file", 'w')
  1148.     or croak "Config::General: Could not open $file!($!)\n";
  1149.     }
  1150.     if (!$config) {
  1151.       if (exists $this->{config}) {
  1152.     $config_string = $this->_store(0, $this->{config});
  1153.       }
  1154.       else {
  1155.     croak "Config::General: No config hash supplied which could be saved to disk!\n";
  1156.       }
  1157.     }
  1158.     else {
  1159.       $config_string = $this->_store(0, $config);
  1160.     }
  1161.  
  1162.     if ($config_string) {
  1163.       print {$fh} $config_string;
  1164.     }
  1165.     else {
  1166.       # empty config for whatever reason, I don't care
  1167.       print {$fh} q();
  1168.     }
  1169.  
  1170.     close $fh;
  1171.   }
  1172.   return;
  1173. }
  1174.  
  1175.  
  1176.  
  1177. sub save_string {
  1178.   #
  1179.   # return the saved config as a string
  1180.   #
  1181.   my($this, $config) = @_;
  1182.  
  1183.   if (!$config || ref($config) ne 'HASH') {
  1184.     if (exists $this->{config}) {
  1185.       return $this->_store(0, $this->{config});
  1186.     }
  1187.     else {
  1188.       croak "Config::General: No config hash supplied which could be saved to disk!\n";
  1189.     }
  1190.   }
  1191.   else {
  1192.     return $this->_store(0, $config);
  1193.   }
  1194.   return;
  1195. }
  1196.  
  1197.  
  1198.  
  1199. sub _store {
  1200.   #
  1201.   # internal sub for saving a block
  1202.   #
  1203.   my($this, $level, $config) = @_;
  1204.   local $_;
  1205.   my $indent = q(    ) x $level;
  1206.  
  1207.   my $config_string = q();
  1208.  
  1209.   foreach my $entry ( $this->{SaveSorted} ? sort keys %$config : keys %$config ) {
  1210.     if (ref($config->{$entry}) eq 'ARRAY') {
  1211.       if( $this->{ForceArray} && scalar @{$config->{$entry}} == 1 && ! ref($config->{$entry}->[0]) ) {
  1212.         # a single value array forced to stay as array
  1213.         $config_string .= $this->_write_scalar($level, $entry, '[' . $config->{$entry}->[0] . ']');
  1214.       }
  1215.       else {
  1216.         foreach my $line ( $this->{SaveSorted} ? sort @{$config->{$entry}} : @{$config->{$entry}} ) {
  1217.           if (ref($line) eq 'HASH') {
  1218.             $config_string .= $this->_write_hash($level, $entry, $line);
  1219.           }
  1220.           else {
  1221.             $config_string .= $this->_write_scalar($level, $entry, $line);
  1222.           }
  1223.         }
  1224.       }
  1225.     }
  1226.     elsif (ref($config->{$entry}) eq 'HASH') {
  1227.       $config_string .= $this->_write_hash($level, $entry, $config->{$entry});
  1228.     }
  1229.     else {
  1230.       $config_string .= $this->_write_scalar($level, $entry, $config->{$entry});
  1231.     }
  1232.   }
  1233.  
  1234.   return $config_string;
  1235. }
  1236.  
  1237.  
  1238. sub _write_scalar {
  1239.   #
  1240.   # internal sub, which writes a scalar
  1241.   # it returns it, in fact
  1242.   #
  1243.   my($this, $level, $entry, $line) = @_;
  1244.  
  1245.   my $indent = q(    ) x $level;
  1246.  
  1247.   my $config_string;
  1248.  
  1249.   # patch fix rt#54583
  1250.   if ( ! defined $line ) {
  1251.     $config_string .= $indent . $entry . "\n";
  1252.   }
  1253.   elsif ($line =~ /\n/ || $line =~ /\\$/) {
  1254.     # it is a here doc
  1255.     my $delimiter;
  1256.     my $tmplimiter = 'EOF';
  1257.     while (!$delimiter) {
  1258.       # create a unique here-doc identifier
  1259.       if ($line =~ /$tmplimiter/s) {
  1260.     $tmplimiter .= '%';
  1261.       }
  1262.       else {
  1263.     $delimiter = $tmplimiter;
  1264.       }
  1265.     }
  1266.     my @lines = split /\n/, $line;
  1267.     $config_string .= $indent . $entry . $this->{StoreDelimiter} . "<<$delimiter\n";
  1268.     foreach (@lines) {
  1269.       $config_string .= $indent . $_ . "\n";
  1270.     }
  1271.     $config_string .= $indent . "$delimiter\n";
  1272.   }
  1273.   else {
  1274.     # a simple stupid scalar entry
  1275.  
  1276.     # re-escape contained $ or # or \ chars
  1277.     $line =~ s/([#\$\\\"])/\\$1/g;
  1278.  
  1279.     # bugfix rt.cpan.org#42287
  1280.     if ($line =~ /^\s/ or $line =~ /\s$/) {
  1281.       # need to quote it
  1282.       $line = "\"$line\"";
  1283.     }
  1284.     $config_string .= $indent . $entry . $this->{StoreDelimiter} . $line . "\n";
  1285.   }
  1286.  
  1287.   return $config_string;
  1288. }
  1289.  
  1290. sub _write_hash {
  1291.   #
  1292.   # internal sub, which writes a hash (block)
  1293.   # it returns it, in fact
  1294.   #
  1295.   my($this, $level, $entry, $line) = @_;
  1296.  
  1297.   my $indent = q(    ) x $level;
  1298.   my $config_string;
  1299.  
  1300.   if ($entry =~ /\s/) {
  1301.     # quote the entry if it contains whitespaces
  1302.     $entry = q(") . $entry . q(");
  1303.   }
  1304.  
  1305.   $config_string .= $indent . q(<) . $entry . ">\n";
  1306.   $config_string .= $this->_store($level + 1, $line);
  1307.   $config_string .= $indent . q(</) . $entry . ">\n";
  1308.  
  1309.   return $config_string
  1310. }
  1311.  
  1312.  
  1313. sub _hashref {
  1314.   #
  1315.   # return a probably tied new empty hash ref
  1316.   #
  1317.   my($this) = @_;
  1318.   if ($this->{Tie}) {
  1319.     eval {
  1320.       eval qq{require $this->{Tie}};
  1321.     };
  1322.     if ($EVAL_ERROR) {
  1323.       croak q(Config::General: Could not create a tied hash of type: ) . $this->{Tie} . q(: ) . $EVAL_ERROR;
  1324.     }
  1325.     my %hash;
  1326.     tie %hash, $this->{Tie};
  1327.     return \%hash;
  1328.   }
  1329.   else {
  1330.     return {};
  1331.   }
  1332. }
  1333.  
  1334.  
  1335.  
  1336. #
  1337. # Procedural interface
  1338. #
  1339. sub ParseConfig {
  1340.   #
  1341.   # @_ may contain everything which is allowed for new()
  1342.   #
  1343.   return (new Config::General(@_))->getall();
  1344. }
  1345.  
  1346. sub SaveConfig {
  1347.   #
  1348.   # 2 parameters are required, filename and hash ref
  1349.   #
  1350.   my ($file, $hash) = @_;
  1351.  
  1352.   if (!$file || !$hash) {
  1353.     croak q{Config::General::SaveConfig(): filename and hash argument required.};
  1354.   }
  1355.   else {
  1356.     if (ref($hash) ne 'HASH') {
  1357.       croak q(Config::General::SaveConfig() The second parameter must be a reference to a hash!);
  1358.     }
  1359.     else {
  1360.       (new Config::General(-ConfigHash => $hash))->save_file($file);
  1361.     }
  1362.   }
  1363.   return;
  1364. }
  1365.  
  1366. sub SaveConfigString {
  1367.   #
  1368.   # same as SaveConfig, but return the config,
  1369.   # instead of saving it
  1370.   #
  1371.   my ($hash) = @_;
  1372.  
  1373.   if (!$hash) {
  1374.     croak q{Config::General::SaveConfigString(): Hash argument required.};
  1375.   }
  1376.   else {
  1377.     if (ref($hash) ne 'HASH') {
  1378.       croak q(Config::General::SaveConfigString() The parameter must be a reference to a hash!);
  1379.     }
  1380.     else {
  1381.       return (new Config::General(-ConfigHash => $hash))->save_string();
  1382.     }
  1383.   }
  1384.   return;
  1385. }
  1386.  
  1387.  
  1388.  
  1389. # keep this one
  1390. 1;
  1391. __END__
  1392.  
  1393.  
  1394.  
  1395.  
  1396.  
  1397. =head1 NAME
  1398.  
  1399. Config::General - Generic Config Module
  1400.  
  1401. =head1 SYNOPSIS
  1402.  
  1403.  #
  1404.  # the OOP way
  1405.  use Config::General;
  1406.  $conf = new Config::General("rcfile");
  1407.  my %config = $conf->getall;
  1408.  
  1409.  #
  1410.  # the procedural way
  1411.  use Config::General qw(ParseConfig SaveConfig SaveConfigString);
  1412.  my %config = ParseConfig("rcfile");
  1413.  
  1414. =head1 DESCRIPTION
  1415.  
  1416. This module opens a config file and parses its contents for you. The B<new> method
  1417. requires one parameter which needs to be a filename. The method B<getall> returns a hash
  1418. which contains all options and its associated values of your config file.
  1419.  
  1420. The format of config files supported by B<Config::General> is inspired by the well known Apache config
  1421. format, in fact, this module is 100% compatible to Apache configs, but you can also just use simple
  1422.  name/value pairs in your config files.
  1423.  
  1424. In addition to the capabilities of an Apache config file it supports some enhancements such as here-documents,
  1425. C-style comments or multiline options.
  1426.  
  1427.  
  1428. =head1 SUBROUTINES/METHODS
  1429.  
  1430. =over
  1431.  
  1432. =item new()
  1433.  
  1434. Possible ways to call B<new()>:
  1435.  
  1436.  $conf = new Config::General("rcfile");
  1437.  
  1438.  $conf = new Config::General(\%somehash);
  1439.  
  1440.  $conf = new Config::General( %options ); # see below for description of possible options
  1441.  
  1442.  
  1443. This method returns a B<Config::General> object (a hash blessed into "Config::General" namespace.
  1444. All further methods must be used from that returned object. see below.
  1445.  
  1446. You can use the new style with hash parameters or the old style which is of course
  1447. still supported. Possible parameters to B<new()> are:
  1448.  
  1449. * a filename of a configfile, which will be opened and parsed by the parser
  1450.  
  1451. or
  1452.  
  1453. * a hash reference, which will be used as the config.
  1454.  
  1455. An alternative way to call B<new()> is supplying an option- hash with one or more of
  1456. the following keys set:
  1457.  
  1458. =over
  1459.  
  1460. =item B<-ConfigFile>
  1461.  
  1462. A filename or a filehandle, i.e.:
  1463.  
  1464.  -ConfigFile => "rcfile" or -ConfigFile => \$FileHandle
  1465.  
  1466.  
  1467.  
  1468. =item B<-ConfigHash>
  1469.  
  1470. A hash reference, which will be used as the config, i.e.:
  1471.  
  1472.  -ConfigHash => \%somehash
  1473.  
  1474.  
  1475.  
  1476. =item B<-String>
  1477.  
  1478. A string which contains a whole config, or an arrayref
  1479. containing the whole config line by line.
  1480. The parser will parse the contents of the string instead
  1481. of a file. i.e:
  1482.  
  1483.  -String => $complete_config
  1484.  
  1485. it is also possible to feed an array reference to -String:
  1486.  
  1487.  -String => \@config_lines
  1488.  
  1489.  
  1490.  
  1491. =item B<-AllowMultiOptions>
  1492.  
  1493. If the value is "no", then multiple identical options are disallowed.
  1494. The default is "yes".
  1495. i.e.:
  1496.  
  1497.  -AllowMultiOptions => "yes"
  1498.  
  1499. see B<IDENTICAL OPTIONS> for details.
  1500.  
  1501. =item B<-LowerCaseNames>
  1502.  
  1503. If set to a true value, then all options found in the config will be converted
  1504. to lowercase. This allows you to provide case-in-sensitive configs. The
  1505. values of the options will B<not> lowercased.
  1506.  
  1507.  
  1508.  
  1509. =item B<-UseApacheInclude>
  1510.  
  1511. If set to a true value, the parser will consider "include ..." as valid include
  1512. statement (just like the well known Apache include statement).
  1513.  
  1514.  
  1515.  
  1516. =item B<-IncludeRelative>
  1517.  
  1518. If set to a true value, included files with a relative path (i.e. "cfg/blah.conf")
  1519. will be opened from within the location of the configfile instead from within the
  1520. location of the script($0). This works only if the configfile has a absolute pathname
  1521. (i.e. "/etc/main.conf").
  1522.  
  1523. If the variable B<-ConfigPath> has been set and if the file to be included could
  1524. not be found in the location relative to the current config file, the module
  1525. will search within B<-ConfigPath> for the file. See the description of B<-ConfigPath>
  1526. for more details.
  1527.  
  1528.  
  1529. =item B<-IncludeDirectories>
  1530.  
  1531. If set to a true value, you may specify include a directory, in which case all
  1532. files inside the directory will be loaded in ASCII order.  Directory includes
  1533. will not recurse into subdirectories.  This is comparable to including a
  1534. directory in Apache-style config files.
  1535.  
  1536.  
  1537. =item B<-IncludeGlob>
  1538.  
  1539. If set to a true value, you may specify a glob pattern for an include to
  1540. include all matching files (e.g. <<include conf.d/*.conf>>).  Also note that as
  1541. with standard file patterns, * will not match dot-files, so <<include dir/*>>
  1542. is often more desirable than including a directory with B<-IncludeDirectories>.
  1543.  
  1544.  
  1545. =item B<-IncludeAgain>
  1546.  
  1547. If set to a true value, you will be able to include a sub-configfile
  1548. multiple times.  With the default, false, you will get a warning about
  1549. duplicate includes and only the first include will succeed.
  1550.  
  1551. Reincluding a configfile can be useful if it contains data that you want to
  1552. be present in multiple places in the data tree.  See the example under
  1553. L</INCLUDES>.
  1554.  
  1555. Note, however, that there is currently no check for include recursion.
  1556.  
  1557.  
  1558. =item B<-ConfigPath>
  1559.  
  1560. As mentioned above, you can use this variable to specify a search path for relative
  1561. config files which have to be included. Config::General will search within this
  1562. path for the file if it cannot find the file at the location relative to the
  1563. current config file.
  1564.  
  1565. To provide multiple search paths you can specify an array reference for the
  1566. path.  For example:
  1567.  
  1568.  @path = qw(/usr/lib/perl /nfs/apps/lib /home/lib);
  1569.  ..
  1570.  -ConfigPath => \@path
  1571.  
  1572.  
  1573.  
  1574. =item B<-MergeDuplicateBlocks>
  1575.  
  1576. If set to a true value, then duplicate blocks, that means blocks and named blocks,
  1577. will be merged into a single one (see below for more details on this).
  1578. The default behavior of Config::General is to create an array if some junk in a
  1579. config appears more than once.
  1580.  
  1581.  
  1582. =item B<-MergeDuplicateOptions>
  1583.  
  1584. If set to a true value, then duplicate options will be merged. That means, if the
  1585. same option occurs more than once, the last one will be used in the resulting
  1586. config hash.
  1587.  
  1588. Setting this option implies B<-AllowMultiOptions == false> unless you set
  1589. B<-AllowMultiOptions> explicit to 'true'. In this case duplicate blocks are
  1590. allowed and put into an array but duplicate options will be merged.
  1591.  
  1592.  
  1593. =item B<-AutoLaunder>
  1594.  
  1595. If set to a true value, then all values in your config file will be laundered
  1596. to allow them to be used under a -T taint flag.  This could be regarded as circumventing
  1597. the purpose of the -T flag, however, if the bad guys can mess with your config file,
  1598. you have problems that -T will not be able to stop.  AutoLaunder will only handle
  1599. a config file being read from -ConfigFile.
  1600.  
  1601.  
  1602.  
  1603. =item B<-AutoTrue>
  1604.  
  1605. If set to a true value, then options in your config file, whose values are set to
  1606. true or false values, will be normalised to 1 or 0 respectively.
  1607.  
  1608. The following values will be considered as B<true>:
  1609.  
  1610.  yes, on, 1, true
  1611.  
  1612. The following values will be considered as B<false>:
  1613.  
  1614.  no, off, 0, false
  1615.  
  1616. This effect is case-insensitive, i.e. both "Yes" or "oN" will result in 1.
  1617.  
  1618.  
  1619. =item B<-FlagBits>
  1620.  
  1621. This option takes one required parameter, which must be a hash reference.
  1622.  
  1623. The supplied hash reference needs to define variables for which you
  1624. want to preset values. Each variable you have defined in this hash-ref
  1625. and which occurs in your config file, will cause this variable being
  1626. set to the preset values to which the value in the config file refers to.
  1627.  
  1628. Multiple flags can be used, separated by the pipe character |.
  1629.  
  1630. Well, an example will clarify things:
  1631.  
  1632.  my $conf = new Config::General(
  1633.          -ConfigFile => "rcfile",
  1634.          -FlagBits => {
  1635.               Mode => {
  1636.                  CLEAR    => 1,
  1637.                  STRONG   => 1,
  1638.                  UNSECURE => "32bit" }
  1639.          }
  1640.  );
  1641.  
  1642. In this example we are defining a variable named I<"Mode"> which
  1643. may contain one or more of "CLEAR", "STRONG" and "UNSECURE" as value.
  1644.  
  1645. The appropriate config entry may look like this:
  1646.  
  1647.  # rcfile
  1648.  Mode = CLEAR | UNSECURE
  1649.  
  1650. The parser will create a hash which will be the value of the key "Mode". This
  1651. hash will contain B<all> flags which you have pre-defined, but only those
  1652. which were set in the config will contain the pre-defined value, the other
  1653. ones will be undefined.
  1654.  
  1655. The resulting config structure would look like this after parsing:
  1656.  
  1657.  %config = (
  1658.              Mode => {
  1659.                        CLEAR    => 1,
  1660.                        UNSECURE => "32bit",
  1661.                        STRONG   => undef,
  1662.                      }
  1663.            );
  1664.  
  1665. This method allows the user (or, the "maintainer" of the configfile for your
  1666. application) to set multiple pre-defined values for one option.
  1667.  
  1668. Please beware, that all occurrences of those variables will be handled this
  1669. way, there is no way to distinguish between variables in different scopes.
  1670. That means, if "Mode" would also occur inside a named block, it would
  1671. also parsed this way.
  1672.  
  1673. Values which are not defined in the hash-ref supplied to the parameter B<-FlagBits>
  1674. and used in the corresponding variable in the config will be ignored.
  1675.  
  1676. Example:
  1677.  
  1678.  # rcfile
  1679.  Mode = BLAH | CLEAR
  1680.  
  1681. would result in this hash structure:
  1682.  
  1683.   %config = (
  1684.              Mode => {
  1685.                        CLEAR    => 1,
  1686.                        UNSECURE => undef,
  1687.                        STRONG   => undef,
  1688.                      }
  1689.            );
  1690.  
  1691. "BLAH" will be ignored silently.
  1692.  
  1693.  
  1694. =item B<-DefaultConfig>
  1695.  
  1696. This can be a hash reference or a simple scalar (string) of a config. This
  1697. causes the module to preset the resulting config hash with the given values,
  1698. which allows you to set default values for particular config options directly.
  1699.  
  1700.  
  1701. =item B<-Tie>
  1702.  
  1703. B<-Tie> takes the name of a Tie class as argument that each new hash should be
  1704. based off of.
  1705.  
  1706. This hash will be used as the 'backing hash' instead of a standard Perl hash,
  1707. which allows you to affect the way, variable storing will be done. You could, for
  1708. example supply a tied hash, say Tie::DxHash, which preserves ordering of the
  1709. keys in the config (which a standard Perl hash won't do). Or, you could supply
  1710. a hash tied to a DBM file to save the parsed variables to disk.
  1711.  
  1712. There are many more things to do in tie-land, see L<tie> to get some interesting
  1713. ideas.
  1714.  
  1715. If you want to use the B<-Tie> feature together with B<-DefaultConfig> make sure
  1716. that the hash supplied to B<-DefaultConfig> must be tied to the same Tie class.
  1717.  
  1718. Make sure that the hash which receives the generated hash structure (e.g. which
  1719. you are using in the assignment: %hash = $config->getall()) must be tied to
  1720. the same Tie class.
  1721.  
  1722. Example:
  1723.  
  1724.  use Config::General qw(ParseConfig);
  1725.  use Tie::IxHash;
  1726.  tie my %hash, "Tie::IxHash";
  1727.  %hash = ParseConfig(
  1728.            -ConfigFile => shift(),
  1729.            -Tie => "Tie::IxHash"
  1730.      );
  1731.  
  1732.  
  1733. =item B<-InterPolateVars>
  1734.  
  1735. If set to a true value, variable interpolation will be done on your config
  1736. input. See L<Config::General::Interpolated> for more information.
  1737.  
  1738. =item B<-InterPolateEnv>
  1739.  
  1740. If set to a true value, environment variables can be used in
  1741. configs.
  1742.  
  1743. This implies B<-InterPolateVars>.
  1744.  
  1745. =item B<-ExtendedAccess>
  1746.  
  1747. If set to a true value, you can use object oriented (extended) methods to
  1748. access the parsed config. See L<Config::General::Extended> for more informations.
  1749.  
  1750. =item B<-StrictObjects>
  1751.  
  1752. By default this is turned on, which causes Config::General to croak with an
  1753. error if you try to access a non-existent key using the OOP-way (B<-ExtendedAcess>
  1754. enabled). If you turn B<-StrictObjects> off (by setting to 0 or "no") it will
  1755. just return an empty object/hash/scalar. This is valid for OOP-access 8via AUTOLOAD
  1756. and for the methods obj(), hash() and value().
  1757.  
  1758.  
  1759. =item B<-StrictVars>
  1760.  
  1761. By default this is turned on, which causes Config::General to croak with an
  1762. error if an undefined variable with B<InterPolateVars> turned on occurs
  1763. in a config. Set to I<false> (i.e. 0) to avoid such error messages.
  1764.  
  1765. =item B<-SplitPolicy>
  1766.  
  1767. You can influence the way how Config::General decides which part of a line
  1768. in a config file is the key and which one is the value. By default it tries
  1769. its best to guess. That means you can mix equalsign assignments and whitespace
  1770. assignments.
  1771.  
  1772. However, somtime you may wish to make it more strictly for some reason. In
  1773. this case you can set B<-SplitPolicy>. The possible values are: 'guess' which
  1774. is the default, 'whitespace' which causes the module to split by whitespace,
  1775. 'equalsign' which causes it to split strictly by equal sign, or 'custom'. In the
  1776. latter case you must also set B<-SplitDelimiter> to some regular expression
  1777. of your choice. For example:
  1778.  
  1779.  -SplitDelimiter => '\s*:\s*'
  1780.  
  1781. will cause the module to split by colon while whitespace which surrounds
  1782. the delimiter will be removed.
  1783.  
  1784. Please note that the delimiter used when saving a config (save_file() or save_string())
  1785. will be chosen according to the current B<-SplitPolicy>. If -SplitPolicy is
  1786. set to 'guess' or 'whitespace', 3 spaces will be used to delimit saved
  1787. options. If 'custom' is set, then you need to set B<-StoreDelimiter>.
  1788.  
  1789. =item B<-SplitDelimiter>
  1790.  
  1791. Set this to any arbitrary regular expression which will be used for option/value
  1792. splitting. B<-SplitPolicy> must be set to 'custom' to make this work.
  1793.  
  1794. =item B<-StoreDelimiter>
  1795.  
  1796. You can use this parameter to specify a custom delimiter to use when saving
  1797. configs to a file or string. You only need to set it if you want to store
  1798. the config back to disk and if you have B<-SplitPolicy> set to 'custom'.
  1799.  
  1800. Be very careful with this parameter.
  1801.  
  1802.  
  1803. =item B<-CComments>
  1804.  
  1805. Config::General is able to notice c-style comments (see section COMMENTS).
  1806. But for some reason you might no need this. In this case you can turn
  1807. this feature off by setting B<-CComments> to a false value('no', 0, 'off').
  1808.  
  1809. By default B<-CComments> is turned on.
  1810.  
  1811.  
  1812. =item B<-BackslashEscape>
  1813.  
  1814. B<Deprecated Option>.
  1815.  
  1816. =item B<-SlashIsDirectory>
  1817.  
  1818. If you turn on this parameter, a single slash as the last character
  1819. of a named block will be considered as a directory name.
  1820.  
  1821. By default this flag is turned off, which makes the module somewhat
  1822. incompatible to Apache configs, since such a setup will be normally
  1823. considered as an explicit empty block, just as XML defines it.
  1824.  
  1825. For example, if you have the following config:
  1826.  
  1827.  <Directory />
  1828.    Index index.awk
  1829.  </Directory>
  1830.  
  1831. you will get such an error message from the parser:
  1832.  
  1833.  EndBlock "</Directory>" has no StartBlock statement (level: 1, chunk 10)!
  1834.  
  1835. This is caused by the fact that the config chunk below will be
  1836. internally converted to:
  1837.  
  1838.  <Directory><Directory />
  1839.    Index index.awk
  1840.  </Directory>
  1841.  
  1842. Now there is one '</Directory>' too much. The proper solution is
  1843. to use quotation to circumvent this error:
  1844.  
  1845.  <Directory "/">
  1846.    Index index.awk
  1847.  </Directory>
  1848.  
  1849. However, a raw apache config comes without such quotes. In this
  1850. case you may consider to turn on B<-SlashIsDirectory>.
  1851.  
  1852. Please note that this is a new option (incorporated in version 2.30),
  1853. it may lead to various unexpected side effects or other failures.
  1854. You've been warned.
  1855.  
  1856. =item B<-ApacheCompatible>
  1857.  
  1858. Over the past years a lot of options has been incorporated
  1859. into Config::General to be able to parse real Apache configs.
  1860.  
  1861. The new B<-ApacheCompatible> option now makes it possible to
  1862. tweak all options in a way that Apache configs can be parsed.
  1863.  
  1864. This is called "apache compatibility mode" - if you will ever
  1865. have problems with parsing Apache configs without this option
  1866. being set, you'll get no help by me. Thanks :)
  1867.  
  1868. The following options will be set:
  1869.  
  1870.  UseApacheInclude   = 1
  1871.  IncludeRelative    = 1
  1872.  IncludeDirectories = 1
  1873.  IncludeGlob        = 1
  1874.  SlashIsDirectory   = 1
  1875.  SplitPolicy        = 'equalsign'
  1876.  CComments          = 0
  1877.  
  1878. Take a look into the particular documentation sections what
  1879. those options are doing.
  1880.  
  1881. Beside setting some options it also turns off support for
  1882. explicit empty blocks.
  1883.  
  1884. =item B<-UTF8>
  1885.  
  1886. If turned on, all files will be opened in utf8 mode. This may
  1887. not work properly with older versions of Perl.
  1888.  
  1889. =item B<-SaveSorted>
  1890.  
  1891. If you want to save configs in a sorted manner, turn this
  1892. parameter on. It is not enabled by default.
  1893.  
  1894. =back
  1895.  
  1896.  
  1897.  
  1898.  
  1899. =item getall()
  1900.  
  1901. Returns a hash structure which represents the whole config.
  1902.  
  1903. =item files()
  1904.  
  1905. Returns a list of all files read in.
  1906.  
  1907. =item save_file()
  1908.  
  1909. Writes the config hash back to the hard disk. This method takes one or two
  1910. parameters. The first parameter must be the filename where the config
  1911. should be written to. The second parameter is optional, it must be a
  1912. reference to a hash structure, if you set it. If you do not supply this second parameter
  1913. then the internal config hash, which has already been parsed, will be
  1914. used.
  1915.  
  1916. Please note that any occurence of comments will be ignored by getall()
  1917. and thus be lost after you call this method.
  1918.  
  1919. You need also to know that named blocks will be converted to nested blocks
  1920. (which is the same from the perl point of view). An example:
  1921.  
  1922.  <user hans>
  1923.    id 13
  1924.  </user>
  1925.  
  1926. will become the following after saving:
  1927.  
  1928.  <user>
  1929.    <hans>
  1930.       id 13
  1931.    </hans>
  1932.  </user>
  1933.  
  1934. Example:
  1935.  
  1936.  $conf_obj->save_file("newrcfile", \%config);
  1937.  
  1938. or, if the config has already been parsed, or if it didn't change:
  1939.  
  1940.  $conf_obj->save_file("newrcfile");
  1941.  
  1942.  
  1943. =item save_string()
  1944.  
  1945. This method is equivalent to the previous save_file(), but it does not
  1946. store the generated config to a file. Instead it returns it as a string,
  1947. which you can save yourself afterwards.
  1948.  
  1949. It takes one optional parameter, which must be a reference to a hash structure.
  1950. If you omit this parameter, the internal config hash, which has already been parsed,
  1951. will be used.
  1952.  
  1953. Example:
  1954.  
  1955.  my $content = $conf_obj->save_string(\%config);
  1956.  
  1957. or:
  1958.  
  1959.  my $content = $conf_obj->save_string();
  1960.  
  1961.  
  1962. =back
  1963.  
  1964.  
  1965. =head1 CONFIG FILE FORMAT
  1966.  
  1967. Lines beginning with B<#> and empty lines will be ignored. (see section COMMENTS!)
  1968. Spaces at the beginning and the end of a line will also be ignored as well as tabulators.
  1969. If you need spaces at the end or the beginning of a value you can surround it with
  1970. double quotes.
  1971. An option line starts with its name followed by a value. An equal sign is optional.
  1972. Some possible examples:
  1973.  
  1974.  user    max
  1975.  user  = max
  1976.  user            max
  1977.  
  1978. If there are more than one statements with the same name, it will create an array
  1979. instead of a scalar. See the example below.
  1980.  
  1981. The method B<getall> returns a hash of all values.
  1982.  
  1983.  
  1984. =head1 BLOCKS
  1985.  
  1986. You can define a B<block> of options. A B<block> looks much like a block
  1987. in the wellknown Apache config format. It starts with E<lt>B<blockname>E<gt> and ends
  1988. with E<lt>/B<blockname>E<gt>. An example:
  1989.  
  1990.  <database>
  1991.     host   = muli
  1992.     user   = moare
  1993.     dbname = modb
  1994.     dbpass = D4r_9Iu
  1995.  </database>
  1996.  
  1997. Blocks can also be nested. Here is a more complicated example:
  1998.  
  1999.  user   = hans
  2000.  server = mc200
  2001.  db     = maxis
  2002.  passwd = D3rf$
  2003.  <jonas>
  2004.         user    = tom
  2005.         db      = unknown
  2006.         host    = mila
  2007.         <tablestructure>
  2008.                 index   int(100000)
  2009.                 name    char(100)
  2010.                 prename char(100)
  2011.                 city    char(100)
  2012.                 status  int(10)
  2013.                 allowed moses
  2014.                 allowed ingram
  2015.                 allowed joice
  2016.         </tablestructure>
  2017.  </jonas>
  2018.  
  2019. The hash which the method B<getall> returns look like that:
  2020.  
  2021.  print Data::Dumper(\%hash);
  2022.  $VAR1 = {
  2023.           'passwd' => 'D3rf$',
  2024.           'jonas'  => {
  2025.                        'tablestructure' => {
  2026.                                              'prename' => 'char(100)',
  2027.                                              'index'   => 'int(100000)',
  2028.                                              'city'    => 'char(100)',
  2029.                                              'name'    => 'char(100)',
  2030.                                              'status'  => 'int(10)',
  2031.                                              'allowed' => [
  2032.                                                             'moses',
  2033.                                                             'ingram',
  2034.                                                             'joice',
  2035.                                                           ]
  2036.                                            },
  2037.                        'host'           => 'mila',
  2038.                        'db'             => 'unknown',
  2039.                        'user'           => 'tom'
  2040.                      },
  2041.           'db'     => 'maxis',
  2042.           'server' => 'mc200',
  2043.           'user'   => 'hans'
  2044.         };
  2045.  
  2046. If you have turned on B<-LowerCaseNames> (see new()) then blocks as in the
  2047. following example:
  2048.  
  2049.  <Dir>
  2050.    <AttriBUTES>
  2051.      Owner  root
  2052.    </attributes>
  2053.  </dir>
  2054.  
  2055. would produce the following hash structure:
  2056.  
  2057.  $VAR1 = {
  2058.           'dir' => {
  2059.                     'attributes' => {
  2060.                                      'owner  => "root",
  2061.                                     }
  2062.                    }
  2063.          };
  2064.  
  2065. As you can see, the keys inside the config hash are normalized.
  2066.  
  2067. Please note, that the above config block would result in a
  2068. valid hash structure, even if B<-LowerCaseNames> is not set!
  2069. This is because I<Config::General> does not
  2070. use the block names to check if a block ends, instead it uses an internal
  2071. state counter, which indicates a block end.
  2072.  
  2073. If the module cannot find an end-block statement, then this block will be ignored.
  2074.  
  2075.  
  2076.  
  2077. =head1 NAMED BLOCKS
  2078.  
  2079. If you need multiple blocks of the same name, then you have to name every block.
  2080. This works much like Apache config. If the module finds a named block, it will
  2081. create a hashref with the left part of the named block as the key containing
  2082. one or more hashrefs with the right part of the block as key containing everything
  2083. inside the block(which may again be nested!). As examples says more than words:
  2084.  
  2085.  # given the following sample
  2086.  <Directory /usr/frisco>
  2087.         Limit Deny
  2088.         Options ExecCgi Index
  2089.  </Directory>
  2090.  <Directory /usr/frik>
  2091.         Limit DenyAll
  2092.         Options None
  2093.  </Directory>
  2094.  
  2095.  # you will get:
  2096.  $VAR1 = {
  2097.           'Directory' => {
  2098.                            '/usr/frik' => {
  2099.                                             'Options' => 'None',
  2100.                                             'Limit' => 'DenyAll'
  2101.                                           },
  2102.                            '/usr/frisco' => {
  2103.                                               'Options' => 'ExecCgi Index',
  2104.                                               'Limit' => 'Deny'
  2105.                                             }
  2106.                          }
  2107.         };
  2108.  
  2109. You cannot have more than one named block with the same name because it will
  2110. be stored in a hashref and therefore be overwritten if a block occurs once more.
  2111.  
  2112.  
  2113. =head1 WHITESPACE IN BLOCKS
  2114.  
  2115. The normal behavior of Config::General is to look for whitespace in
  2116. block names to decide if it's a named block or just a simple block.
  2117.  
  2118. Sometimes you may need blocknames which have whitespace in their names.
  2119.  
  2120. With named blocks this is no problem, as the module only looks for the
  2121. first whitespace:
  2122.  
  2123.  <person hugo gera>
  2124.  </person>
  2125.  
  2126. would be parsed to:
  2127.  
  2128.  $VAR1 = {
  2129.           'person' => {
  2130.                        'hugo gera' => {
  2131.                                       },
  2132.                       }
  2133.          };
  2134.  
  2135. The problem occurs, if you want to have a simple block containing whitespace:
  2136.  
  2137.  <hugo gera>
  2138.  </hugo gera>
  2139.  
  2140. This would be parsed as a named block, which is not what you wanted. In this
  2141. very case you may use quotation marks to indicate that it is not a named block:
  2142.  
  2143.  <"hugo gera">
  2144.  </"hugo gera">
  2145.  
  2146. The save() method of the module inserts automatically quotation marks in such
  2147. cases.
  2148.  
  2149.  
  2150. =head1 EXPLICIT EMPTY BLOCKS
  2151.  
  2152. Beside the notation of blocks mentioned above it is possible to use
  2153. explicit empty blocks.
  2154.  
  2155. Normally you would write this in your config to define an empty
  2156. block:
  2157.  
  2158.  <driver Apache>
  2159.  </driver>
  2160.  
  2161. To save writing you can also write:
  2162.  
  2163.  <driver Apache/>
  2164.  
  2165. which is the very same as above. This works for normal blocks and
  2166. for named blocks.
  2167.  
  2168.  
  2169.  
  2170. =head1 IDENTICAL OPTIONS (ARRAYS)
  2171.  
  2172. You may have more than one line of the same option with different values.
  2173.  
  2174. Example:
  2175.  log  log1
  2176.  log  log2
  2177.  log  log2
  2178.  
  2179. You will get a scalar if the option occurred only once or an array if it occurred
  2180. more than once. If you expect multiple identical options, then you may need to
  2181. check if an option occurred more than once:
  2182.  
  2183.  $allowed = $hash{jonas}->{tablestructure}->{allowed};
  2184.  if(ref($allowed) eq "ARRAY") {
  2185.      @ALLOWED = @{$allowed};
  2186.  else {
  2187.      @ALLOWED = ($allowed);
  2188.  }
  2189.  
  2190. The same applies to blocks and named blocks too (they are described in more detail
  2191. below). For example, if you have the following config:
  2192.  
  2193.  <dir blah>
  2194.    user max
  2195.  </dir>
  2196.  <dir blah>
  2197.    user hannes
  2198.  </dir>
  2199.  
  2200. then you would end up with a data structure like this:
  2201.  
  2202.  $VAR1 = {
  2203.           'dir' => {
  2204.                     'blah' => [
  2205.                                 {
  2206.                                   'user' => 'max'
  2207.                                 },
  2208.                                 {
  2209.                                   'user' => 'hannes'
  2210.                                 }
  2211.                               ]
  2212.                     }
  2213.           };
  2214.  
  2215. As you can see, the two identical blocks are stored in a hash which contains
  2216. an array(-reference) of hashes.
  2217.  
  2218. Under some rare conditions you might not want this behavior with blocks (and
  2219. named blocks too). If you want to get one single hash with the contents of
  2220. both identical blocks, then you need to turn the B<new()> parameter B<-MergeDuplicateBlocks>
  2221. on (see above). The parsed structure of the example above would then look like
  2222. this:
  2223.  
  2224.  $VAR1 = {
  2225.           'dir' => {
  2226.                     'blah' => {
  2227.                    'user' => [
  2228.                        'max',
  2229.                        'hannes'
  2230.                      ]
  2231.                               }
  2232.                     }
  2233.           };
  2234.  
  2235. As you can see, there is only one hash "dir->{blah}" containing multiple
  2236. "user" entries. As you can also see, turning on  B<-MergeDuplicateBlocks>
  2237. does not affect scalar options (i.e. "option = value"). In fact you can
  2238. tune merging of duplicate blocks and options independent from each other.
  2239.  
  2240. If you don't want to allow more than one identical options, you may turn it off
  2241. by setting the flag I<AllowMultiOptions> in the B<new()> method to "no".
  2242. If turned off, Config::General will complain about multiple occurring options
  2243. with identical names!
  2244.  
  2245. =head2 FORCE SINGLE VALUE ARRAYS
  2246.  
  2247. You may also force a single config line to get parsed into an array by
  2248. turning on the option B<-ForceArray> and by surrounding the value of the
  2249. config entry by []. Example:
  2250.  
  2251.  hostlist = [ foo.bar ]
  2252.  
  2253. Will be a singlevalue array entry if the option is turned on. If you want
  2254. it to remain to be an array you have to turn on B<-ForceArray> during save too.
  2255.  
  2256. =head1 LONG LINES
  2257.  
  2258. If you have a config value, which is too long and would take more than one line,
  2259. you can break it into multiple lines by using the backslash character at the end
  2260. of the line. The Config::General module will concatenate those lines to one single-value.
  2261.  
  2262. Example:
  2263.  
  2264. command = cat /var/log/secure/tripwire | \
  2265.            mail C<-s> "report from tripwire" \
  2266.            honey@myotherhost.nl
  2267.  
  2268. command will become:
  2269.  "cat /var/log/secure/tripwire | mail C<-s> 'report from twire' honey@myotherhost.nl"
  2270.  
  2271.  
  2272. =head1 HERE DOCUMENTS
  2273.  
  2274. You can also define a config value as a so called "here-document". You must tell
  2275. the module an identifier which idicates the end of a here document. An
  2276. identifier must follow a "<<".
  2277.  
  2278. Example:
  2279.  
  2280.  message <<EOF
  2281.    we want to
  2282.    remove the
  2283.    homedir of
  2284.    root.
  2285.  EOF
  2286.  
  2287. Everything between the two "EOF" strings will be in the option I<message>.
  2288.  
  2289. There is a special feature which allows you to use indentation with here documents.
  2290. You can have any amount of whitespace or tabulators in front of the end
  2291. identifier. If the module finds spaces or tabs then it will remove exactly those
  2292. amount of spaces from every line inside the here-document.
  2293.  
  2294. Example:
  2295.  
  2296.  message <<EOF
  2297.          we want to
  2298.          remove the
  2299.          homedir of
  2300.          root.
  2301.       EOF
  2302.  
  2303. After parsing, message will become:
  2304.  
  2305.    we want to
  2306.    remove the
  2307.    homedir of
  2308.    root.
  2309.  
  2310. because there were the string "     " in front of EOF, which were cut from every
  2311. line inside the here-document.
  2312.  
  2313.  
  2314.  
  2315. =head1 INCLUDES
  2316.  
  2317. You can include an external file at any posision in your config file using the following statement
  2318. in your config file:
  2319.  
  2320.  <<include externalconfig.rc>>
  2321.  
  2322. If you turned on B<-UseApacheInclude> (see B<new()>), then you can also use the following
  2323. statement to include an external file:
  2324.  
  2325.  include externalconfig.rc
  2326.  
  2327. This file will be inserted at the position where it was found as if the contents of this file
  2328. were directly at this position.
  2329.  
  2330. You can also recursively include files, so an included file may include another one and so on.
  2331. Beware that you do not recursively load the same file, you will end with an error message like
  2332. "too many open files in system!".
  2333.  
  2334. By default included files with a relative pathname will be opened from within the current
  2335. working directory. Under some circumstances it maybe possible to
  2336. open included files from the directory, where the configfile resides. You need to turn on
  2337. the option B<-IncludeRelative> (see B<new()>) if you want that. An example:
  2338.  
  2339.  my $conf = Config::General(
  2340.                              -ConfigFile => "/etc/crypt.d/server.cfg"
  2341.                              -IncludeRelative => 1
  2342.                            );
  2343.  
  2344.  /etc/crypt.d/server.cfg:
  2345.   <<include acl.cfg>>
  2346.  
  2347. In this example Config::General will try to include I<acl.cfg> from I</etc/crypt.d>:
  2348.  
  2349.  /etc/crypt.d/acl.cfg
  2350.  
  2351. The default behavior (if B<-IncludeRelative> is B<not> set!) will be to open just I<acl.cfg>,
  2352. wherever it is, i.e. if you did a chdir("/usr/local/etc"), then Config::General will include:
  2353.  
  2354.  /usr/local/etc/acl.cfg
  2355.  
  2356. Include statements can be case insensitive (added in version 1.25).
  2357.  
  2358. Include statements will be ignored within C-Comments and here-documents.
  2359.  
  2360. By default, a config file will only be included the first time it is
  2361. referenced.  If you wish to include a file in multiple places, set
  2362. B</-IncludeAgain> to true. But be warned: this may lead to infinite loops,
  2363. so make sure, you're not including the same file from within itself!
  2364.  
  2365. Example:
  2366.  
  2367.     # main.cfg
  2368.     <object billy>
  2369.         class=Some::Class
  2370.         <printers>
  2371.             include printers.cfg
  2372.         </printers>
  2373.         # ...
  2374.     </object>
  2375.     <object bob>
  2376.         class=Another::Class
  2377.         <printers>
  2378.             include printers.cfg
  2379.         </printers>
  2380.         # ...
  2381.     </object>
  2382.  
  2383. Now C<printers.cfg> will be include in both the C<billy> and C<bob> objects.
  2384.  
  2385. You will have to be careful to not recursively include a file.  Behaviour
  2386. in this case is undefined.
  2387.  
  2388.  
  2389.  
  2390. =head1 COMMENTS
  2391.  
  2392. A comment starts with the number sign B<#>, there can be any number of spaces and/or
  2393. tab stops in front of the #.
  2394.  
  2395. A comment can also occur after a config statement. Example:
  2396.  
  2397.  username = max  # this is the comment
  2398.  
  2399. If you want to comment out a large block you can use C-style comments. A B</*> signals
  2400. the begin of a comment block and the B<*/> signals the end of the comment block.
  2401. Example:
  2402.  
  2403.  user  = max # valid option
  2404.  db    = tothemax
  2405.  /*
  2406.  user  = andors
  2407.  db    = toand
  2408.  */
  2409.  
  2410. In this example the second options of user and db will be ignored. Please beware of the fact,
  2411. if the Module finds a B</*> string which is the start of a comment block, but no matching
  2412. end block, it will ignore the whole rest of the config file!
  2413.  
  2414. B<NOTE:> If you require the B<#> character (number sign) to remain in the option value, then
  2415. you can use a backslash in front of it, to escape it. Example:
  2416.  
  2417.  bgcolor = \#ffffcc
  2418.  
  2419. In this example the value of $config{bgcolor} will be "#ffffcc", Config::General will not treat
  2420. the number sign as the begin of a comment because of the leading backslash.
  2421.  
  2422. Inside here-documents escaping of number signs is NOT required!
  2423.  
  2424.  
  2425. =head1 OBJECT ORIENTED INTERFACE
  2426.  
  2427. There is a way to access a parsed config the OO-way.
  2428. Use the module B<Config::General::Extended>, which is
  2429. supplied with the Config::General distribution.
  2430.  
  2431. =head1 VARIABLE INTERPOLATION
  2432.  
  2433. You can use variables inside your config files if you like. To do
  2434. that you have to use the module B<Config::General::Interpolated>,
  2435. which is supplied with the Config::General distribution.
  2436.  
  2437.  
  2438. =head1 EXPORTED FUNCTIONS
  2439.  
  2440. Config::General exports some functions too, which makes it somewhat
  2441. easier to use it, if you like this.
  2442.  
  2443. How to import the functions:
  2444.  
  2445.  use Config::General qw(ParseConfig SaveConfig SaveConfigString);
  2446.  
  2447. =over
  2448.  
  2449. =item B<ParseConfig()>
  2450.  
  2451. This function takes exactly all those parameters, which are
  2452. allowed to the B<new()> method of the standard interface.
  2453.  
  2454. Example:
  2455.  
  2456.  use Config::General qw(ParseConfig);
  2457.  my %config = ParseConfig(-ConfigFile => "rcfile", -AutoTrue => 1);
  2458.  
  2459.  
  2460. =item B<SaveConfig()>
  2461.  
  2462. This function requires two arguments, a filename and a reference
  2463. to a hash structure.
  2464.  
  2465. Example:
  2466.  
  2467.  use Config::General qw(SaveConfig);
  2468.  ..
  2469.  SaveConfig("rcfile", \%some_hash);
  2470.  
  2471.  
  2472. =item B<SaveConfigString()>
  2473.  
  2474. This function requires a reference to a config hash as parameter.
  2475. It generates a configuration based on this hash as the object-interface
  2476. method B<save_string()> does.
  2477.  
  2478. Example:
  2479.  
  2480.  use Config::General qw(ParseConfig SaveConfigString);
  2481.  my %config = ParseConfig(-ConfigFile => "rcfile");
  2482.  .. # change %config something
  2483.  my $content = SaveConfigString(\%config);
  2484.  
  2485.  
  2486. =back
  2487.  
  2488. =head1 CONFIGURATION AND ENVIRONMENT
  2489.  
  2490. No environment variables will be used.
  2491.  
  2492. =head1 SEE ALSO
  2493.  
  2494. I recommend you to read the following documents, which are supplied with Perl:
  2495.  
  2496.  perlreftut                     Perl references short introduction
  2497.  perlref                        Perl references, the rest of the story
  2498.  perldsc                        Perl data structures intro
  2499.  perllol                        Perl data structures: arrays of arrays
  2500.  
  2501.  Config::General::Extended      Object oriented interface to parsed configs
  2502.  Config::General::Interpolated  Allows to use variables inside config files
  2503.  
  2504. =head1 LICENSE AND COPYRIGHT
  2505.  
  2506. Copyright (c) 2000-2010 Thomas Linden
  2507.  
  2508. This library is free software; you can redistribute it and/or
  2509. modify it under the same terms as Perl itself.
  2510.  
  2511. =head1 BUGS AND LIMITATIONS
  2512.  
  2513. See rt.cpan.org for current bugs, if any.
  2514.  
  2515. =head1 INCOMPATIBILITIES
  2516.  
  2517. None known.
  2518.  
  2519. =head1 DIAGNOSTICS
  2520.  
  2521. To debug Config::General use the Perl debugger, see L<perldebug>.
  2522.  
  2523. =head1 DEPENDENCIES
  2524.  
  2525. Config::General depends on the modules L<FileHandle>,
  2526. L<File::Spec::Functions>, L<File::Glob>, which all are
  2527. shipped with Perl.
  2528.  
  2529. =head1 AUTHOR
  2530.  
  2531. Thomas Linden <tlinden |AT| cpan.org>
  2532.  
  2533. =head1 VERSION
  2534.  
  2535. 2.48
  2536.  
  2537. =cut
  2538.  
  2539.